home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 9 / Night Owl CD-ROM (NOPV9) (Night Owl Publisher) (1993).ISO / 054a / hsd114b0.zip / HOST.WAS next >
Text File  |  1993-05-19  |  39KB  |  1,143 lines
  1. ;Host Mode script v1.00b
  2. ;Modified 5/19/93 Samuel H. Smith to include HS/Link protocol
  3. ;note: assumes that HSLINK.DLP is the only (or FIRST) DLP protocol available!
  4.  
  5. ;***********************************************************************
  6. ;*                                                                     *   
  7. ;* HOST.WAS                                                            *
  8. ;* Copyright (C) 1992 Datastorm Technologies, Inc.                     *     
  9. ;* All rights reserverd.                                               * 
  10. ;*                                                                     * 
  11. ;* Purpose: Provides an interface for a remote user to send and        *
  12. ;*          receive files and electronic mail.                         *
  13. ;*                                                                     * 
  14. ;***********************************************************************
  15.  
  16. ;***********************************************************************
  17. ;*                                                                     *
  18. ;*  WARNING!!!!                                                        *
  19. ;*                                                                     *
  20. ;*  Do not modify this script file unless you have a good under-       *
  21. ;*  standing of the Windows ASPECT language.  If you do modify this    *
  22. ;*  script, PLEASE MAKE A BACKUP before doing so.                      *
  23. ;*                                                                     *
  24. ;***********************************************************************
  25.  
  26. ;***********************************************************************
  27. ;*                                                                     *
  28. ;*   MACRO DEFINITIONS                                                 *
  29. ;*                                                                     *
  30. ;***********************************************************************
  31. #define FALSE 0         ; Boolean variables
  32. #define TRUE  1         ;
  33.  
  34. #define NAMEMAX 30      ; maximum length for user name
  35. #define PSWDMAX 8       ; maximum user passwrd length
  36.  
  37. #define DISP 1          ; show characters for input
  38. #define MASK 0          ; hide characters for password input
  39.  
  40. #define MODEM_CON    0  ; Connection type is a MODEM
  41. #define DIRECT_CON   1  ; Connection type is direct cable / no MODEM
  42.  
  43. #define OPEN_SYSTEM   0 ; anyone can login
  44. #define CLOSED_SYSTEM 1 ; only users already in the HOST.USR can login
  45.  
  46. ; access_level levels for users
  47. #define NEWUSER      0  ; new - can't do file xfers
  48. #define REGUSER      1  ; normal-can do file xfers to upload/download areas
  49. #define SUPERUSER    2  ; super-can do file xfers to/from any drive/directory
  50.  
  51. #define FLD_SEP    59   ; Field separator is ACSII 59 (semi-colon)
  52.  
  53. #define HOSTUSRFILE  "HOST.USR" ; User data file
  54. #define HOSTLOGFILE  "HOST.LOG" ; Log of Host activity
  55. #define HOSTPRMFILE  "HOST.PRM" ; Parameter file
  56. #define HOSTHLPFILE  "HOST.HLP" ; Help file
  57. #define HOSTNWSFILE  "HOST.NWS" ; News file
  58. #define HOSTNUFILE   "HOST.NUF" ; New user file
  59. #define HOSTDNLDFILE "HOST.DNL" ; Download file list
  60.  
  61. ;Mail Defines
  62. #define HOSTMSGFILE  "HOST.MSG" ; Mail message file
  63. #define HOSTHDRFILE  "HOST.HDR" ; Mail header file
  64. #define PUBLIC     0    ; Mail message flags
  65. #define PRIVATE    1    ;
  66. #define NEWMAIL    2    ;
  67. #define DELETED    4    ;
  68.  
  69. ;***********************************************************************
  70. ;*                                                                     *
  71. ;*   GLOBAL VARIABLES                                                  *
  72. ;*                                                                     *
  73. ;***********************************************************************
  74. string welcome_msg, upload_path, dnload_path, ontime, offtime
  75. string record, name, first, last, passwrd, access_level, remarks, msg
  76. string logfile, parmfile, usrfile, newsfile, hlpfile, dnldfile
  77. string nufile, _time, _date, message, searchstr
  78. string hdrfile, msgfile, tempfile
  79. integer new_usr_level, connect_type, system_type, goodbye_option
  80. integer old_menu, new_menu, tempkey, status, msg_number
  81. integer action_status, dial_status, setup_status, meta_status
  82. integer local_logon, jump, sysop, already_saved
  83.  
  84. ;***********************************************************************
  85. ;*                                                                     *   
  86. ;* MAIN                                                                *
  87. ;*                                                                     *
  88. ;* This is the main program loop.                                      *
  89. ;*                                                                     *
  90. ;* Calls: SAVE_PRM, HOSTSETUP, HOSTLOG, WAITFORCALL,  GETUSER,         *
  91. ;*        DISPLAYFILE, CHECKMAIL, HOSTMENU                             *
  92. ;*                                                                     *
  93. ;* Modifies globals: action_status, meta_status, dial_status, name,    *
  94. ;*                   setup_status, jump, local_logon, new_menu, sysop, *
  95. ;*                   connect_type, newsfile, msg, access_level,        *
  96. ;*                   parmfile                                          *
  97. ;*                                                                     *
  98. ;***********************************************************************
  99. #include "SUBS.WAS"             ;host subroutine library
  100. #include "MAIL.WAS"             ;host mail routines
  101.  
  102. proc main
  103.  
  104.    set aspect spawn on                 ; allow spawning of scripts
  105.    fetch aspect scriptpath parmfile    ; build a path to the HOST.PRM
  106.    addfilename parmfile HOSTPRMFILE
  107.  
  108.    if not isfile parmfile              ; if the .PRM doesn't exist
  109.       execute "HOSTUTIL"               ; run HOSTUTIL.WAS
  110.    endif
  111.                                        ; get the status of the
  112.    action_status=$ACTIONBAR            ; programs modeless windows
  113.    meta_status=$METAKEYS
  114.    dial_status=$DIALDIR
  115.    setup_status=$SETUP
  116.    if action_status                    ; if action bar is on
  117.       actionbar off                    ;  turn it off
  118.     endif
  119.    if meta_status                      ; if metakeys are on
  120.       metakeys off                     ;  turn them off
  121.    endif
  122.  
  123.    if dial_status                      ; if dialing directory is on
  124.       dialdir off                      ;  turn it off
  125.    endif
  126.  
  127.    if setup_status                     ; if setup is on
  128.       setup off                        ;  turn it off
  129.    endif
  130.  
  131.    already_saved=0
  132.    
  133.    while 1
  134.       statmsg " "
  135.       setjmp 1 jump
  136.       HostSetup()            ; set system variables and open HOST.PRM
  137.       HostLog("Host mode online.", "")
  138.       pwtitlebar "PROCOMM PLUS for Windows - Host Mode"
  139.       WaitForCall()
  140.  
  141.       if local_logon
  142.          menuitem new_menu 3 "&Recycle!"
  143.          showmenu new_menu
  144.       else
  145.          enable menu 2
  146.       endif
  147.  
  148.       menuitem new_menu 4 "E&xit Host!"
  149.       showmenu new_menu
  150.  
  151.       if !sysop
  152.          GetUser()               ; Wait for someone to login
  153.          if success              ; If user logged on,
  154.             if (! $carrier) && (connect_type==MODEM_CON)
  155.                HostLog("Lost Carrier.", "")
  156.                loopwhile
  157.             endif
  158.             DisplayFile(newsfile, 23)
  159.             strfmt msg "Remote user %s online" name
  160.             pwtitlebar msg
  161.             if local_logon
  162.                HostLog(name, "logged in locally.")
  163.             else
  164.                HostLog(name, "logged in.")
  165.             endif
  166.             CheckMail()
  167.             HostMenu()
  168.          endif
  169.       else
  170.          name = "SYSOP"
  171.          access_level="2"
  172.          time ontime
  173.          CheckMail()
  174.          HostMenu()
  175.       endif
  176.    endwhile
  177. endproc
  178.  
  179. ;***********************************************************************
  180. ;*                                                                     *   
  181. ;* HOSTMENU                                                            *
  182. ;*                                                                     *
  183. ;* This procedure is the main menu for the remote user.                *
  184. ;*                                                                     *
  185. ;*                                                                     * 
  186. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, DISPLAYFILE,        *
  187. ;*        FILELIST, UPLOAD, DOWNLOAD, CHAT, READMAIL, LEAVEMAIL,       *
  188. ;*        HOSTHANGUP, EXITHOST, HOSTGETYN, RESTORE_PRM, SWITCHDIR      *
  189. ;*                                                                     *
  190. ;* Modifies globals: access_level, connect_type, dnldfile, local_logon,*
  191. ;*                   hlpfile, offtime, ontime, goodbye_option, name,   *
  192. ;*                   action_status, meta_status,  dial_status,         *
  193. ;*                   setup_status                                      *
  194. ;*                                                                     *
  195. ;***********************************************************************
  196. proc HostMenu
  197. integer security
  198. string key, auto_ans_off
  199.    ;convert access_level level into an integer
  200.    atoi access_level security
  201.  
  202.    set txpace 0
  203.    while 1
  204.       HostPutS("`r`n")
  205.       HostPutS("`r`nF)iles      U)pload      D)ownload")
  206.       HostPutS("`r`nH)elp       T)ime        C)hat")
  207.       HostPutS("`r`nR)ead mail  L)eave mail  G)oodbye")
  208.  
  209.       if security==2
  210.          HostPutS("`r`n`r`nS)witch directory")
  211.          HostPutS("`r`nA)bort (SHUT DOWN host mode)")
  212.       endif
  213.  
  214.       HostPutS("`r`n`r`nYour Choice? ")
  215.  
  216.       if (! $carrier) && (connect_type==MODEM_CON)
  217.          HostLog("Lost Carrier", "")
  218.          SetFailure()
  219.          exitwhile
  220.       endif
  221.  
  222.       HostGetC(&key)
  223.       if failure
  224.          exitwhile
  225.       endif
  226.  
  227.       HostPutS(key)
  228.  
  229.       switch key
  230. ;****************
  231. ;* F)iles       *
  232. ;****************
  233.          case "F"
  234.             if security!=2
  235.                fetch aspect scriptpath dnldfile
  236.                addfilename dnldfile HOSTDNLDFILE
  237.                DisplayFile(dnldfile, 23)
  238.                if not success
  239.                   FileList()
  240.                endif
  241.             else
  242.                FileList()
  243.             endif
  244.          endcase
  245. ;****************
  246. ;* U)pload      *
  247. ;****************
  248.          case "U"
  249.             if local_logon
  250.                HostPutS("`r`n`r`nYou can't transfer files during a local logon!`r`n`r`n")
  251.             else
  252.                if security==0
  253.                   HostPutS("`r`n`r`nYou aren't authorized to transfer files!`r`n`r`n")
  254.                else
  255.                   Upload()
  256.                endif
  257.             endif
  258.          endcase
  259. ;****************
  260. ;* D)ownload    *
  261. ;****************
  262.          case "D"
  263.             if local_logon
  264.                HostPutS("`r`n`r`nYou can't transfer files during a local logon!`r`n`r`n")
  265.             else
  266.                if security==0
  267.                   HostPutS("`r`n`r`nYou aren't authorized to transfer files!`r`n`r`n")
  268.                else
  269.                   Download()
  270.                endif
  271.             endif
  272.          endcase
  273. ;****************
  274. ;* H)elp        *
  275. ;****************
  276.          case "H"
  277.             fetch aspect scriptpath hlpfile
  278.             addfilename hlpfile HOSTHLPFILE
  279.             DisplayFile(hlpfile, 23)
  280.             if not success
  281.                HostPutS("`r`nHelp not available.`r`n")
  282.             endif
  283.          endcase
  284. ;****************
  285. ;* T)ime        *
  286. ;****************
  287.          case "T"
  288.             time offtime
  289.             HostPutS("`r`n`r`nOnline at: ")
  290.             HostPutS(ontime)
  291.             HostPutS("`r`nIt is now: ")
  292.             HostPuts(offtime)
  293.             HostPutS("`r`n`r`n")
  294.          endcase
  295. ;****************
  296. ;* C)hat        *
  297. ;****************
  298.          case "C"
  299.             if local_logon
  300.                HostPutS("`r`n`r`nYou can't chat during a local logon!`r`n`r`n")
  301.             else
  302.                Chat()
  303.             endif
  304.          endcase
  305. ;****************
  306. ;* R)ead Mail   *
  307. ;****************
  308.          case "R"
  309.             ReadMail()
  310.          endcase
  311. ;****************
  312. ;* L)eave Mail  *
  313. ;****************
  314.          case "L"
  315.             LeaveMail(0,"", "")
  316.          endcase
  317. ;****************
  318. ;* G)oodbye     *
  319. ;****************
  320.          case "G"                                ;Goodbye
  321.             time offtime
  322.             HostPutS("`r`n`r`nOnline at: ")
  323.             HostPutS(ontime)
  324.             HostPutS("`r`nIt is now: ")
  325.             HostPuts(offtime)
  326.             HostPutS("`r`n`r`n")
  327.                 
  328.             if connect_type==MODEM_CON
  329.                HostHangup()
  330.             endif
  331.             if goodbye_option==1
  332.                clear
  333.                ExitHost()
  334.             endif
  335.             HostLog(name, "logged out.")
  336.             exitwhile
  337.          endcase
  338. ;****************
  339. ; A)bort        *
  340. ;****************
  341.          case "A"
  342.             if security==2
  343.                HostPutS("`r`n`r`nAbort Host Mode (Y/N)?")
  344.                HostGetYN()
  345.                if success
  346.                   HostPutS("`r`nAborting ...`r`n")
  347.                   HostLog(name, "remote shutdown.")
  348.                   if connect_type==MODEM_CON
  349.                      HostPutS("`r`nHangup line (Y/N)?")
  350.                      HostGetYN()
  351.                      if success
  352.                         HostHangup()
  353.                         ; get modem auto answer string
  354.                         fetch modem autoansoff auto_ans_off   
  355.                         set txpace 50
  356.                         transmit auto_ans_off
  357.                         waitfor "OK" 5
  358.                         restore_prm()
  359.                      endif
  360.                   endif
  361.                   if action_status
  362.                      actionbar on
  363.                   endif
  364.                   if meta_status
  365.                      metakeys on
  366.                   endif
  367.                   if dial_status
  368.                      dialdir on
  369.                   endif
  370.                   if setup_status
  371.                      setup on
  372.                   endif
  373.                   clear
  374.                   statmsg " "
  375.                   pwtitlebar "PROCOMM PLUS for Windows"
  376.                   halt
  377.                endif
  378.             endif
  379.          endcase
  380. ;****************
  381. ; S)witch       *
  382. ;****************
  383.          case "S"
  384.             if security==2
  385.                SwitchDir()
  386.             endif
  387.          endcase
  388. ;***************
  389.       endswitch
  390.    endwhile
  391. endproc
  392.  
  393. ;***********************************************************************
  394. ;*                                                                     *   
  395. ;* FILELIST                                                            *
  396. ;*                                                                     *
  397. ;* This procedure displays a file directory for the user like the      *
  398. ;* DOS "DIR" command.                                                  *
  399. ;*                                                                     * 
  400. ;* Calls: HOSTPUTS, HOSTGETS, HOSTGETC                                 *
  401. ;*                                                                     *
  402. ;* Modifies globals: access_level, dnload_path,  msg                   *
  403. ;*                                                                     *
  404. ;***********************************************************************
  405. proc FileList
  406. string filespec, filepath, key, dirflag="<DIR>"
  407. integer security, again=0, linenum=1, maxlen=40
  408.     
  409.    atoi access_level security
  410.  
  411.    HostPutS("`r`nEnter FILE SPEC: (Carriage Return = *.*)`r`n> ")
  412.    HostGetS(&filespec, maxlen, DISP)
  413.  
  414.    strcmp filespec ""
  415.    if success
  416.       filespec="*.*"
  417.    endif
  418.  
  419.    if security!=2
  420.       strcpy filepath dnload_path
  421.       addfilename filepath filespec
  422.    else
  423.       getdir 0 filepath
  424.       strfind filespec "\"
  425.       if not found
  426.          addfilename filepath filespec
  427.       else
  428.          strcpy filepath filespec
  429.       endif
  430.    endif
  431.  
  432.    findfirst filepath "D"
  433.    if found
  434.       strfind $FATTR "D"
  435.       if found
  436.          strfmt msg "`r`n`r`n %-12s  %8s  %9s  %s`r`n" $FILENAME dirflag $FDATE $FTIME
  437.       else
  438.          strfmt msg "`r`n`r`n %-12s  %8ld  %9s  %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
  439.       endif
  440.       HostPutS(msg)
  441.       linenum++
  442.       again=1
  443.    else
  444.       HostPutS("`r`n`r`nNo files found.`r`n")
  445.    endif
  446.    while again
  447.       if linenum==23
  448.          linenum=1
  449.          HostPutS("-MORE-")
  450.          HostGetC(&key)
  451.          HostPutS("`b`b`b`b`b`b")
  452.          strupr key
  453.          strcmp key "N"
  454.          if success
  455.             exitwhile
  456.          endif
  457.       endif
  458.  
  459.       findnext
  460.       if found
  461.          strfind $FATTR "D"
  462.          if found
  463.             strfmt msg " %-12s  %8s  %9s  %s`r`n" $FILENAME dirflag $FDATE $FTIME
  464.          else
  465.             strfmt msg " %-12s  %8ld  %9s  %s`r`n" $FILENAME $FSIZE $FDATE $FTIME
  466.          endif
  467.          HostPutS(msg)
  468.          linenum++
  469.       else
  470.          HostPutS("`r`n-End of list.-`r`n")
  471.          exitwhile
  472.       endif
  473.    endwhile
  474. endproc
  475.  
  476. ;***********************************************************************
  477. ;*                                                                     *   
  478. ;* UPLOAD                                                              *
  479. ;*                                                                     *
  480. ;* This procedure provides a menu for the remote user to send files    *
  481. ;* to the host system.                                                 *
  482. ;*                                                                     * 
  483. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, GETFNAME,           *
  484. ;*        ISWILDCARD, TXWAIT                                           *
  485. ;*                                                                     *
  486. ;* Modifies globals: connect_type, status, msg, name                   *
  487. ;*                                                                     *
  488. ;***********************************************************************
  489. proc upload
  490. string filename, choice
  491. string xferbegin = "`r`nBegin your transfer procedure...  (CTRL-X aborts)`r`n"
  492. integer calledfrom = 0
  493.  
  494.    while 1
  495.       HostPutS("`r`n")
  496.       HostPutS("`r`nK) Kermit      X) Xmodem")
  497.       HostPutS("`r`nO) 1K-Xmodem   E) 1K-Xmodem-G")
  498.       HostPutS("`r`nY) Ymodem      G) Ymodem-G (Batch)")
  499.       HostPutS("`r`nZ) Zmodem      H) HS/Link")
  500.       HostPutS("`r`n")
  501.       HostPutS("`r`nYour choice? ")
  502.  
  503.       if (! $carrier) && (connect_type==MODEM_CON)
  504.          HostLog("Lost Carrier", "")
  505.          SetFailure()
  506.          exitwhile
  507.       endif
  508.       HostGetC(&choice)
  509.       if failure
  510.          exitwhile
  511.       endif
  512.       HostPutS(choice)
  513.  
  514.       switch choice
  515. ;****************
  516. ;* K)ermit      *
  517. ;****************
  518.          case "K"
  519.             GetFname(&filename, calledfrom)
  520.             if failure
  521.                exitwhile
  522.             endif
  523.             HostPutS(xferbegin)
  524.             txwait()
  525.             getfile kermit
  526.          endcase
  527. ;****************
  528. ;* X)modem      *
  529. ;****************
  530.          case "X"
  531.             GetFname(&filename, calledfrom)
  532.             if failure
  533.                exitwhile
  534.             endif
  535.             IsWildcard(&filename)
  536.             if failure
  537.                exitwhile
  538.             endif
  539.             HostPutS(xferbegin)
  540.             txwait()
  541.             getfile xmodem filename
  542.          endcase
  543. ;****************
  544. ;* Z)modem      *
  545. ;****************
  546.          case "Z"
  547.             GetFname(&filename, calledfrom)
  548.             if failure
  549.                exitwhile
  550.             endif
  551.             HostPutS(xferbegin)
  552.             txwait()
  553.             getfile zmodem
  554.          endcase
  555. ;****************
  556. ;* Y)modem      *
  557. ;****************
  558.          case "Y"
  559.             GetFname(&filename, calledfrom)
  560.             if failure
  561.                exitwhile
  562.             endif
  563.             HostPutS(xferbegin)
  564.             txwait()
  565.             getfile ymodem
  566.          endcase
  567. ;****************
  568. ;* O) 1K Xmodem *
  569. ;****************
  570.          case "O"
  571.             GetFname(&filename, calledfrom)
  572.             if failure
  573.                exitwhile
  574.             endif
  575.             IsWildcard(&filename)
  576.             if failure
  577.                exitwhile
  578.             endif
  579.             HostPutS(xferbegin)
  580.             txwait()
  581.             getfile 1kxmodem filename
  582.          endcase
  583. ;****************
  584. ;* E) 1K XmodemG*
  585. ;****************
  586.          case "E"
  587.             GetFname(&filename, calledfrom)
  588.             if failure
  589.                exitwhile
  590.             endif
  591.             IsWildcard(&filename)
  592.             if failure
  593.                exitwhile
  594.             endif
  595.             HostPutS(xferbegin)
  596.             txwait()
  597.             getfile 1kxmodemg filename
  598.          endcase
  599. ;****************
  600. ;* Y)modem-G    *
  601. ;****************
  602.          case "G"
  603.             GetFname(&filename, calledfrom)
  604.             if failure
  605.                exitwhile
  606.             endif
  607.             HostPutS(xferbegin)
  608.             txwait()
  609.             getfile ymodemg
  610.          endcase
  611. ;****************
  612. ;* H)s/link     *
  613. ;****************
  614.          case "H"
  615.             GetFname(&filename, calledfrom)
  616.             if failure
  617.                exitwhile
  618.             endif
  619.             HostPutS(xferbegin)
  620.             txwait()
  621.             getfile 10
  622.          endcase
  623. ;****************
  624. ;* Default      *
  625. ;****************
  626.          default
  627.             exitwhile
  628.          endcase
  629.       endswitch
  630.  
  631.       pause 1
  632.  
  633.       status=$FILEXFER
  634.     
  635.       while status==1
  636.          ;loop here while xfer is going on
  637.          status=$FILEXFER
  638.       endwhile
  639.  
  640.       if status==2
  641.          HostPutS("`r`nTRANSFER COMPLETE.`r`n")
  642.          strfmt msg "uploaded %s successfully." filename
  643.          HostLog(name, msg) ;log a sucessful upload
  644.       elseif status==3
  645.          ;log a failed upload
  646.          pause 2
  647.          rxflush
  648.          txflush
  649.          HostPutS("`r`nTRANSFER ABORTED!`r`n`r`n")
  650.          strfmt msg "failed to upload %s." filename
  651.          HostLog(name, msg) ;log a sucessful upload
  652.       endif
  653.       exitwhile
  654.    endwhile
  655. endproc
  656.  
  657. ;***********************************************************************
  658. ;*                                                                     *   
  659. ;* DOWNLOAD                                                            *
  660. ;*                                                                     *
  661. ;* This procedure provides a menu for the remote user to receive       *
  662. ;* files.                                                              *
  663. ;*                                                                     * 
  664. ;* Calls: HOSTPUTS, HOSTLOG, SETFAILURE, HOSTGETC, GETFNAME,           *
  665. ;*        ISWILDCARD, TXWAIT                                           *
  666. ;*                                                                     *
  667. ;* Modifies globals: connect_type, status, msg, name                   *
  668. ;*                                                                     *
  669. ;***********************************************************************
  670. proc download
  671.  
  672. string filename, choice
  673. string xferbegin = "`r`nBegin your transfer procedure...  (CTRL-X aborts)`r`n"
  674. integer calledfrom = 1
  675.  
  676.    while 1
  677.       HostPutS("`r`n")
  678.       HostPutS("`r`nK) Kermit      X) Xmodem")
  679.       HostPutS("`r`nO) 1K-Xmodem   E) 1K-Xmodem-G")
  680.       HostPutS("`r`nY) Ymodem      G) Ymodem-G (Batch)")
  681.       HostPutS("`r`nZ) Zmodem      H) HS/Link")
  682.       HostPutS("`r`n")
  683.       HostPutS("`r`nYour choice? ")
  684.  
  685.       if (! $carrier) && (connect_type==MODEM_CON)
  686.          HostLog("Lost Carrier", "")
  687.          SetFailure()
  688.          exitwhile
  689.       endif
  690.  
  691.       HostGetC(&choice)
  692.       if failure
  693.          exitwhile
  694.       endif
  695.  
  696.       HostPutS(choice)
  697.  
  698.       switch choice
  699. ;****************
  700. ;* K)ermit      *
  701. ;****************
  702.          case "K"
  703.             GetFname(&filename, calledfrom)
  704.             if failure
  705.                exitwhile
  706.             endif
  707.             HostPutS(xferbegin)
  708.             txwait()
  709.             sendfile kermit filename
  710.          endcase
  711. ;****************
  712. ;* X)modem      *
  713. ;****************
  714.          case "X"
  715.             GetFname(&filename, calledfrom)
  716.             if failure
  717.                exitwhile
  718.             endif
  719.             IsWildcard(&filename)
  720.             if failure
  721.                exitwhile
  722.             endif
  723.             HostPutS(xferbegin)
  724.             txwait()
  725.             sendfile xmodem filename
  726.          endcase
  727. ;****************
  728. ;* Z)modem      *
  729. ;****************
  730.          case "Z"
  731.             GetFname(&filename, calledfrom)
  732.             if failure
  733.                exitwhile
  734.             endif
  735.             HostPutS(xferbegin)
  736.             txwait()
  737.             sendfile zmodem filename
  738.          endcase
  739. ;****************
  740. ;* Y)modem      *
  741. ;****************
  742.          case "Y"
  743.             GetFname(&filename, calledfrom)
  744.             if failure
  745.                exitwhile
  746.             endif
  747.             HostPutS(xferbegin)
  748.             txwait()
  749.             sendfile ymodem filename
  750.          endcase
  751. ;****************
  752. ;* O) 1K Xmodem *
  753. ;****************
  754.          case "O"
  755.             GetFname(&filename, calledfrom)
  756.             if failure
  757.                exitwhile
  758.             endif
  759.             IsWildcard(&filename)
  760.             if failure
  761.                exitwhile
  762.             endif
  763.  
  764.             HostPutS(xferbegin)
  765.             txwait()
  766.             sendfile 1kxmodem filename
  767.          endcase
  768. ;****************
  769. ;* E) 1K XmodemG*
  770. ;****************
  771.          case "E"
  772.             GetFname(&filename, calledfrom)
  773.             if failure
  774.                exitwhile
  775.             endif
  776.             IsWildcard(&filename)
  777.             if failure
  778.                exitwhile
  779.             endif
  780.             HostPutS(xferbegin)
  781.             txwait()
  782.             sendfile 1kxmodemg filename
  783.          endcase
  784. ;****************
  785. ;* Y)modem-G    *
  786. ;****************
  787.          case "G"
  788.             GetFname(&filename, calledfrom)
  789.             if failure
  790.                exitwhile
  791.             endif
  792.             HostPutS(xferbegin)
  793.             txwait()
  794.             sendfile ymodemg filename
  795.          endcase
  796. ;****************
  797. ;* H)s/link     *
  798. ;****************
  799.          case "H"
  800.             GetFname(&filename, calledfrom)
  801.             if failure
  802.                exitwhile
  803.             endif
  804.             HostPutS(xferbegin)
  805.             txwait()
  806.             sendfile 10 filename
  807.          endcase
  808. ;****************
  809. ;* Default      *
  810. ;****************
  811.          default
  812.             exitwhile
  813.          endcase
  814.       endswitch
  815.  
  816.       pause 1
  817.  
  818.       status=$FILEXFER
  819.     
  820.       while status==1
  821.          ;loop here while xfer is going on
  822.          status=$FILEXFER
  823.       endwhile
  824.         
  825.       rxflush
  826.       txflush
  827.       pause 1
  828.         
  829.       if status==2
  830.          HostPutS("`r`nTRANSFER COMPLETE.`r`n")
  831.          strfmt msg "downloaded %s successfully." filename
  832.          HostLog(name, msg) ;log a sucessful download
  833.       elseif status==3
  834.          HostPutS("`r`nTRANSFER ABORTED!`r`n`r`n")
  835.          strfmt msg "failed to download %s." filename
  836.          HostLog(name, msg) ;log a sucessful download
  837.       endif
  838.       exitwhile
  839.    endwhile
  840. endproc
  841.  
  842. ;***********************************************************************
  843. ;*                                                                     *   
  844. ;* GETFNAME                                                            *
  845. ;*                                                                     *
  846. ;* This procedure validates a filename for upload or download.         *
  847. ;*                                                                     *
  848. ;* Input:  string fname (filename to be validated)                     *
  849. ;*         integer calledfrom (upload or download menu)                *
  850. ;*                                                                     *
  851. ;* Return:  Success for vaild filename, Failure on invalid filename    *
  852. ;*                                                                     *
  853. ;*                                                                     *
  854. ;* Notes:  Keeps level 1 users from downloading any file they want     *
  855. ;*                                                                     *
  856. ;* Calls: HOSTPUTS, HOSTGETS, SETFAILURE, SETSUCCESS, HOSTGETYN        *                                                     *
  857. ;*                                                                     *
  858. ;* Modifies globals: dnload_path,  access_level, msg                   *
  859. ;*                                                                     *
  860. ;*                                                                     *
  861. ;***********************************************************************
  862. proc GetFname
  863. strparm fname
  864. intparm calledfrom
  865. string filepath
  866. integer security, length
  867.  
  868.  
  869.    if calledfrom==0              ; user is uploading
  870.       filepath=upload_path
  871.    else
  872.       filepath=dnload_path       ; user is downloading
  873.    endif
  874.  
  875.    atoi access_level security
  876.  
  877.    HostPutS("`r`n`r`nFile name? ")
  878.  
  879.    HostGetS(&fname, 50, DISP)    ; get the filename
  880.    if failure
  881.       SetFailure()
  882.       return
  883.    endif
  884.  
  885.    strcmp fname ""               ; make sure user didn't hit
  886.    if success                    ; ENTER for the filename
  887.       SetFailure()
  888.       return
  889.    endif
  890.  
  891.    strlen fname length
  892.    if length>12
  893.       HostPutS("`r`nFilename is too long!`r`n`r`n")
  894.       SetFailure()
  895.       return
  896.    endif
  897.  
  898.    strupr fname                  ; uppercase the filename
  899.    HostPutS("`r`n")
  900.    if security!=2
  901.       strfind fname ":"          ; don't let regular users upload to
  902.       if found                   ; another drive
  903.          strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
  904.          HostPutS(msg)
  905.          SetFailure()
  906.          return
  907.       endif
  908.  
  909.       strfind fname "\"          ; don't let regular users upload to
  910.       if found                   ; another path
  911.          strfmt msg "`r`n%s <==Invalid character in filename!`r`n" fname
  912.          HostPutS(msg)
  913.          SetFailure()
  914.          return
  915.       endif
  916.  
  917.       set dnldpath filepath
  918.       addfilename filepath fname ; build a fullpath for the filename
  919.       fname=filepath
  920.    else
  921.       getdir 0 filepath             ; level 2 users will upload to
  922.       set dnldpath filepath
  923.       addfilename filepath fname    ; the current directory
  924.       fname=filepath
  925.    endif
  926.  
  927.    findfirst fname                  ; find the file to see if it exist
  928.    if not found
  929.       if calledfrom == 1            ; if user is downloading
  930.          HostPutS("`r`nFile not found!`r`n")
  931.          SetFailure()
  932.          return
  933.       else
  934.          SetSuccess()
  935.          return
  936.       endif
  937.    else
  938.       if calledfrom == 0           ; user is uploading
  939.          if security !=2
  940.             HostPutS("`r`nFile already exists!`r`n")
  941.             SetFailure()
  942.             return
  943.          else
  944.             HostputS("`r`nFile exists, overwrite? ")
  945.             HostGetYN()
  946.             if success
  947.                HostPutS("`r`n")
  948.                delfile fname
  949.                if not success
  950.                   HostPutS("`r`n`r`nCan't delete file!`r`n")
  951.                   SetFailure()
  952.                   return
  953.                endif
  954.                SetSuccess()
  955.                return
  956.             else
  957.                SetFailure()
  958.                return
  959.             endif
  960.             HostPutS("`r`n")
  961.             SetFailure()
  962.             return
  963.          endif
  964.       endif
  965.       SetSuccess()
  966.    endif
  967.    HostPutS("`r`n")
  968. endproc
  969.  
  970. ;***********************************************************************
  971. ;*                                                                     *   
  972. ;* ISWILDCARD                                                          *
  973. ;*                                                                     *
  974. ;* This procedure keeps users from specifying wildcard characters in   *
  975. ;* a filename for transfer protocols that do no support them.          *
  976. ;*                                                                     *
  977. ;* Input:  string fname (filename to validate)                         *
  978. ;*                                                                     *
  979. ;* Return:  Success for valid filename, Failure otherwise              *
  980. ;*                                                                     * 
  981. ;* Calls: HOSTPUTS, SETFAILURE, SETSUCCESS                             *
  982. ;*                                                                     *
  983. ;* Modifies globals: none                                              *
  984. ;*                                                                     *
  985. ;***********************************************************************
  986. proc IsWildcard
  987. strparm fname
  988. string error = "`r`nNo wildcards allowed!`r`n"
  989.  
  990.    strfind fname "*"
  991.    if found
  992.       HostPutS(error)
  993.       SetFailure()
  994.       return
  995.    endif
  996.  
  997.    strfind fname "?"
  998.    if found
  999.       HostPutS(error)
  1000.       SetFailure()
  1001.       return
  1002.    endif
  1003.  
  1004.    SetSuccess()
  1005. endproc
  1006.  
  1007. ;***********************************************************************
  1008. ;*                                                                     *   
  1009. ;* SWITCHDIR                                                           *
  1010. ;*                                                                     *
  1011. ;* This procedure allows a level 2 user to change the working          *
  1012. ;* directory                                                           *
  1013. ;*                                                                     * 
  1014. ;* Calls: HOSTPUTS, HOSTGETS, ISWILDCARD, HOSTLOG                      *
  1015. ;*                                                                     *
  1016. ;* Modifies globals: msg, name                                         *
  1017. ;*                                                                     *
  1018. ;***********************************************************************
  1019. proc SwitchDir
  1020. string filepath, newpath
  1021.  
  1022.    getdir 0 filepath
  1023.    strfmt msg "`r`nCurrent directory is %s`r`n" filepath
  1024.    HostPutS(msg)
  1025.    HostPutS("Change to what directory? ")
  1026.    HostGetS(&newpath, 50, DISP)
  1027.    if success
  1028.       IsWildcard(newpath)
  1029.       HostPuts("`r`n")
  1030.       chdir newpath
  1031.       strfmt msg "changed directory to %s." newpath
  1032.       HostLog(name, msg)
  1033.       getdir 0 newpath
  1034.       strfmt msg "`r`nCurrent directory is now %s`r`n" newpath
  1035.       HostPuts(msg)
  1036.    endif
  1037. endproc
  1038.  
  1039. ;***********************************************************************
  1040. ;*                                                                     *   
  1041. ;* HOSTLOG                                                             *
  1042. ;*                                                                     *
  1043. ;* This procedure puts an activity message into the HOST.LOG file.     *
  1044. ;*                                                                     * 
  1045. ;* Calls: HOSTMSGBOX                                                   *
  1046. ;*                                                                     *
  1047. ;* Modifies globals: logfile, msg                                      *
  1048. ;*                                                                     *
  1049. ;***********************************************************************
  1050. proc HostLog
  1051. strparm activity1
  1052. strparm activity2
  1053.  
  1054.    isfile logfile
  1055.    if not success                       ;if new file put header at top
  1056.       fopen 1 logfile CREATE TEXT
  1057.       if success
  1058.          fputs 1 "  DATE      TIME             ACTIVITY"
  1059.          fputs 1 "--------  ----------   --------------------------------"
  1060.          fclose 1
  1061.       else
  1062.          HostMsgBox("Can't create HOST.LOG file!")
  1063.          return
  1064.       endif
  1065.    endif
  1066.         
  1067.    fopen 1 logfile WRITE TEXT
  1068.    if not success
  1069.       HostMsgBox("Can't open HOST.LOG file!")
  1070.       return
  1071.    endif
  1072.    fseek 1 0 2
  1073.    strfmt msg "%s  %s   %s %s" $DATE $TIME activity1 activity2
  1074.    fputs 1 msg
  1075.    fclose 1
  1076. endproc
  1077.  
  1078. ;***********************************************************************
  1079. ;*                                                                     *   
  1080. ;* SAVE_PRM                                                            *
  1081. ;*                                                                     *
  1082. ;* This procedure save_prm renames PW.PRM to PW.PRX and saves the      *
  1083. ;* current setup.                                                      *
  1084. ;*                                                                     * 
  1085. ;* Calls: nothing                                                      *
  1086. ;* Called by: MAIN                                                     *
  1087. ;* Modifies globals: none                                              *
  1088. ;*                                                                     *
  1089. ;***********************************************************************
  1090. proc save_prm
  1091. string prmfile
  1092. string oldprm="PW.PRM"
  1093. string newprm="PRM.BAK"
  1094.  
  1095.    if already_saved
  1096.       return
  1097.    endif
  1098.    already_saved=1   
  1099.    prmfile=$PWTASKPATH
  1100.    addfilename prmfile oldprm
  1101.    oldprm=prmfile
  1102.  
  1103.    prmfile=$PWTASKPATH
  1104.    addfilename prmfile newprm
  1105.    newprm=prmfile
  1106.    copyfile oldprm newprm
  1107.    savesetup
  1108. endproc
  1109.  
  1110. ;***********************************************************************
  1111. ;*                                                                     *   
  1112. ;* RESTORE_PRM                                                         *
  1113. ;*                                                                     *
  1114. ;* This procedure restore_prm restores the setup from disk and         *
  1115. ;* renames the PW.PRX file back to PW.PRM.                             *
  1116. ;*                                                                     * 
  1117. ;* Calls: NONE                                                         *
  1118. ;* Called by: ExitHost                                                 *
  1119. ;* Modifies globals: none                                              *
  1120. ;*                                                                     *
  1121. ;***********************************************************************
  1122. proc restore_prm
  1123. string prmfile
  1124. string oldprm="PW.PRM"
  1125. string newprm="PRM.BAK"
  1126.  
  1127.    restsetup
  1128.    prmfile=$PWTASKPATH
  1129.    addfilename prmfile oldprm
  1130.    oldprm=prmfile
  1131.  
  1132.    prmfile=$PWTASKPATH
  1133.    addfilename prmfile newprm
  1134.  
  1135.    newprm=prmfile
  1136.    delfile oldprm
  1137.    copyfile newprm oldprm
  1138.    isfile newprm
  1139.    delfile newprm
  1140. endproc
  1141.  
  1142. ;**** End of HOST.WAS ****
  1143.